home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 2: CDPD 1 / Almathera Ten on Ten - Disc 2: CDPD 1.iso / pd / 101-125 / 118 / hammmm / mmm_screen < prev    next >
Text File  |  1995-03-13  |  4KB  |  138 lines
  1. \ Make screen and window for HAMmmm display.
  2. \ Use double buffering to achieve smooth animation.
  3. \
  4. \ Author: Phil Burk
  5. \ Copyright 1987 Phil Burk
  6. \ This code is considered to be in the public domain and
  7. \ may be freely distributed but may not be sold for profit.
  8.  
  9. ANEW TASK-MMM_SCREEN
  10.  
  11. \ Declare Intuition structures.
  12. NewScreen HAMNewScreen
  13. NewWindow HAMNewWindow
  14.  
  15. VARIABLE HAMScreen  ( holder for relative screen pointer )
  16.  
  17. \ Define drawing surface.
  18. 0 constant HAM_XMIN
  19. 10 constant HAM_YMIN
  20. 320 constant HAM_XMAX
  21. 200 constant HAM_YMAX
  22.  
  23. : HAM.OPEN ( -- , open custom HAM screen )
  24.      gr.init   
  25. \ Set to default values.
  26.      HAMNewScreen NewScreen.Setup
  27.      HAMNewWindow NewWindow.Setup
  28. \
  29. \ Modify defaults for this demo.
  30.      HAM HAMNewScreen ..! ns_viewmodes   ( Change to HAM )
  31.      6 HAMNewScreen ..! ns_depth
  32.      0" HAMmmm    by Phil Burk" >abs
  33.          HAMNewScreen ..! ns_DefaultTitle
  34. \
  35. \ Open Screen and store pointer in NewWindow structure.
  36.      HAMNewScreen openscreen() dup HAMScreen !  ( Open screen. )
  37.      >abs HAMNewWindow ..! nw_screen   ( Modify window for this screen. )
  38. \
  39. \ Set up Backdrop window.
  40.      CUSTOMSCREEN   HAMNewWindow ..! nw_type
  41.      0    HAMNewWindow ..! nw_TopEdge
  42.      ham_xmax  HAMNewWindow ..! nw_Width
  43.      ham_ymax  HAMNewWindow ..! nw_Height
  44.      BACKDROP  ACTIVATE | BORDERLESS | HAMNewWindow ..! nw_flags
  45.      MENUVERIFY MENUPICK | HAMNewWindow ..! nw_IDCMPFlags
  46.      HAMNewWindow gr.openwindow gr.set.curwindow
  47. \
  48. \ Sometimes the Amiga can build a bad COPPER list for screens.
  49. \ This can happen if you have Emacs up in INTERLACE mode and open a
  50. \ NON-INTERLACE screen.
  51. \ The following call will correct this problem (hopefully).
  52.     RemakeDisplay()
  53. ;
  54.  
  55. : HAM.CLOSE ( -- , Close screen and window.)
  56.     gr.closecurw
  57.     HAMScreen @ closescreen()
  58. ;
  59.  
  60. \ -----------------------------------------------
  61. \ ------- Double Buffering ----------------------
  62. \ -----------------------------------------------
  63. \
  64. \ A BACKDROP window's Rastport points to the Bitmap
  65. \ that is contained in the screen structure.  This
  66. \ Bitmap points to 6 planes allocated by intuition.
  67. \ We can switch to a new drawing surface by replacing
  68. \ the original 6 plane pointers with pointers to
  69. \ our own 6 planes.  We can then draw into these planes
  70. \ using the Rastport from the window.  When we are through
  71. \ drawing we can make these visible by rebuilding the
  72. \ display Copper lists. By repeating this process we can
  73. \ always be drawing into a surface that is not visible
  74. \ thus eliminating visual breakup of the display.
  75.  
  76. 6 array BIT-PLANES-0  ( store pointers to drawing surfaces )
  77. 6 array BIT-PLANES-1
  78.  
  79. : ALLOC.BIT.PLANES ( -- , allocate second drawing surface )
  80.     6 0
  81.     DO 320 200 allocraster() >abs
  82.        i bit-planes-1 !
  83.     LOOP
  84. ;
  85. : FREE.BIT.PLANES ( -- , free when done )
  86.     6 0
  87.     DO i bit-planes-1 @
  88.        >rel 320 200 freeraster()
  89.     LOOP
  90. ;
  91.  
  92. : SCREEN.PLANE.BASE  ( -- addr , of pointer to first plane )
  93.     hamscreen @ .. sc_bitmap .. bm_planes
  94. ;
  95.  
  96. variable PLANES-CURRENT  ( 0/1 )
  97.  
  98. : GRAB.FIRST.BUFFER ( -- , get planes allocated by OpenScreen )
  99.     screen.plane.base 0 bit-planes-0 6 cells move
  100.     0 planes-current !
  101. ;
  102.  
  103. : HAM.REBUILD ( -- , rebuild HAM screen , make changes visible )
  104.     hamscreen @ >abs call intuition_lib makescreen drop
  105.     call intuition_lib rethinkdisplay drop
  106. ;
  107.  
  108. : SWAP.BUFFERS ( -- , swap bit planes so draw in next buffer )
  109.     planes-current @ 0=
  110.     IF 0 bit-planes-1
  111.     ELSE 0 bit-planes-0
  112.     THEN
  113.     screen.plane.base 6 cells move
  114.     planes-current @ 1 xor planes-current !
  115. ;
  116.  
  117. : HAM.SHOW&SWAP ( flag -- )
  118.     dup not
  119.     HAMScreen @ swap showtitle()  ( force REdraw )
  120.     HAMScreen @ swap showtitle()
  121.     swap.buffers
  122. ;
  123.  
  124. : BUFFERS.INIT ( -- )
  125.     alloc.bit.planes
  126.     grab.first.buffer
  127.     swap.buffers
  128.     1 ham.show&swap
  129. ;
  130.  
  131. : BUFFERS.TERM  ( -- )
  132. \ Make sure CloseScreen deallocates proper planes.
  133.     planes-current @ 0= 0=
  134.     IF swap.buffers
  135.     THEN
  136.     free.bit.planes
  137. ;
  138.